home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / RECORDS.SWG / 0002_BLOCKRW2.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  7KB  |  215 lines
  1. (* Program to demonstrate BlockRead and BlockWrite    *)
  2. (* routines.                                          *)
  3. Program BlockReadWriteDemo;
  4. Uses
  5.   Crt;
  6. Type
  7.   st20 = String[20];
  8.   st40 = String[40];
  9.   st80 = String[80];
  10.  
  11.   rcPersonInfo = Record
  12.                    stFirst : st20;
  13.                    stLast  : st20;
  14.                    byAge   : Byte
  15.                  end;
  16. Const
  17.   coRecSize = sizeof(rcPersonInfo);
  18.  
  19. Var
  20.   wototalRecs : Word;
  21.   rcTemp      : rcPersonInfo;
  22.   fiData      : File;
  23.  
  24.   (***** Initialize Program Variables.                              *)
  25.   Procedure Init;
  26.   begin
  27.     ClrScr;
  28.     wototalRecs := 0;
  29.     fillChar(rcTemp, coRecSize, 0);
  30.     fillChar(fiData, sizeof(fiData), 0)
  31.   end;        (* Init.                                              *)
  32.  
  33.   (***** Handle Program errors.                                     *)
  34.   Procedure ErrorHandler(byErrorNumber : Byte; boHalt : Boolean);
  35.   begin
  36.     Case byErrorNumber of
  37.       1 : Writeln('Error creating new data-File.');
  38.       2 : Writeln('Error writing Record to data-File.');
  39.       3 : Writeln('Record does not exist.');
  40.       4 : Writeln('Error reading Record from data-File.');
  41.       5 : Writeln('Error erasing Record in data-File.')
  42.     end;      (* Case byErrorNumber of                              *)
  43.     if boHalt then
  44.       halt(byErrorNumber)
  45.   end;        (* ErrorHandler.                                      *)
  46.  
  47.   (***** Create new data-File to hold Record data.                  *)
  48.   Function CreateDataFile(Var fiData : File) : Boolean;
  49.   begin
  50.     {$I-}
  51.     reWrite(fiData, 1);
  52.     {$I+}
  53.     if (ioresult = 0) then
  54.       CreateDataFile := True
  55.     else
  56.       CreateDataFile := False
  57.   end;        (* CreateDataFile.                                    *)
  58.  
  59.   (***** Open data-File.                                            *)
  60.   Procedure OpenDataFile(Var fiData : File; stFileName : st80);
  61.   begin
  62.     assign(fiData, stFileName);
  63.     {$I-}
  64.     reset(fiData, 1);
  65.     {$I+}
  66.     if (ioresult <> 0) then
  67.       begin
  68.         if (CreateDataFile(fiData) = False) then
  69.           ErrorHandler(1, True)
  70.         else
  71.           Writeln('New data-File ', stFileName, ' created.')
  72.       end
  73.     else
  74.       Writeln('Data-File ', stFileName, ' opened.');
  75.     wototalRecs := Filesize(fiData) div coRecSize
  76.   end;        (* OpenDataFile.                                      *)
  77.  
  78.   (***** Add a Record to the data-File.                             *)
  79.   Procedure AddRecord(woRecNum : Word; Var rcTemp : rcPersonInfo);
  80.   Var
  81.     woBytesWritten : Word;
  82.   begin
  83.     if (woRecNum > succ(wototalRecs)) then
  84.       woRecNum := succ(wototalRecs);
  85.     seek(fiData, (pred(woRecNum) * coRecSize));
  86.     blockWrite(fiData, rcTemp, coRecSize, woBytesWritten);
  87.     if (woBytesWritten = coRecSize) then
  88.       inc(wototalRecs)
  89.     else
  90.       ErrorHandler(2, True)
  91.   end;        (* AddRecord.                                         *)
  92.  
  93.  
  94. (***  PART 2     *****)
  95.  
  96.   (***** Get a Record from the data-File.                           *)
  97.   Procedure GetRecord(woRecNum : Word; Var rcTemp : rcPersonInfo);
  98.   Var
  99.     woBytesRead : Word;
  100.   begin
  101.     if (woRecNum > wototalRecs)
  102.     or (woRecNum < 1) then
  103.       begin
  104.         ErrorHandler(3, False);
  105.         Exit
  106.       end;
  107.     seek(fiData, (pred(woRecNum) * coRecSize));
  108.     blockread(fiData, rcTemp, coRecSize, woBytesRead);
  109.     if (woBytesRead <> coRecSize) then
  110.       ErrorHandler(4, True)
  111.   end;        (* GetRecord.                                         *)
  112.  
  113.   (***** Erase the contents of a data-File Record.                  *)
  114.   Procedure EraseRecord(woRecNum : Word);
  115.   Var
  116.     woBytesWritten : Word;
  117.     rcEmpty        : rcPersonInfo;
  118.   begin
  119.     if (woRecNum > wototalRecs)
  120.     or (woRecNum < 1) then
  121.       begin
  122.         ErrorHandler(3, False);
  123.         Exit
  124.       end;
  125.     fillChar(rcEmpty, coRecSize, 0);
  126.     seek(fiData, (pred(woRecNum) * coRecSize));
  127.     blockWrite(fiData, rcEmpty, coRecSize, woBytesWritten);
  128.     if (woBytesWritten <> coRecSize) then
  129.       ErrorHandler(5, True)
  130.   end;        (* EraseRecord.                                       *)
  131.  
  132.   (***** Display a Record's fields.                                 *)
  133.   Procedure DisplayRecord(Var rcTemp : rcPersonInfo);
  134.   begin
  135.     With rcTemp do
  136.       begin
  137.         Writeln;
  138.         Writeln(' Firstname = ', stFirst);
  139.         Writeln(' Lastname  = ', stLast);
  140.         Writeln(' Age       = ', byAge);
  141.         Writeln
  142.       end
  143.   end;        (* DisplayRecord.                                     *)
  144.  
  145.   (***** Enter data into a Record.                                  *)
  146.   Procedure EnterRecData(Var rcTemp : rcPersonInfo);
  147.   begin
  148.     Writeln;
  149.     With rcTemp do
  150.       begin
  151.         Write('Enter First-name : ');
  152.         readln(stFirst);
  153.         Write('Enter Last-name  : ');
  154.         readln(stLast);
  155.         Write('Enter Age        : ');
  156.         readln(byAge)
  157.       end;
  158.     Writeln
  159.   end;        (* EnterRecData.                                      *)
  160.  
  161.   (***** Obtain user response to Yes/No question.                   *)
  162.   Function YesNo(stMessage : st40) : Boolean;
  163.   Var
  164.     chTemp : Char;
  165.   begin
  166.     Writeln;
  167.     Write(stMessage, ' (Y/N) [ ]', #8#8);
  168.     While KeyPressed do
  169.       chTemp := ReadKey;
  170.     Repeat
  171.       chTemp := upCase(ReadKey)
  172.     Until (chTemp in ['Y','N']);
  173.     Writeln(chTemp);
  174.     if (chTemp = 'Y') then
  175.       YesNo := True
  176.     else
  177.       YesNo := False
  178.   end;        (* YesNo.                                             *)
  179.  
  180.   (***** Compact data-File by removing empty Records.               *)
  181.   Procedure PackDataFile(Var fiData : File);
  182.   begin
  183.     (* This one I'm leaving For you to Complete.                    *)
  184.   end;        (* PackDataFile.                                      *)
  185.  
  186. (***** PART 3   *****)
  187.               (* Main Program execution block.                      *)
  188. begin
  189.   Init;
  190.   OpenDataFile(fiData, 'TEST.DAT');
  191.   rcTemp.stFirst := 'Bill';
  192.   rcTemp.stLast  := 'Gates';
  193.   rcTemp.byAge   := 36;
  194.   DisplayRecord(rcTemp);
  195.   AddRecord(1, rcTemp);
  196.   rcTemp.stFirst := 'Phillipe';
  197.   rcTemp.stLast  := 'Khan ';
  198.   rcTemp.byAge   := 39;
  199.   DisplayRecord(rcTemp);
  200.   AddRecord(2, rcTemp);
  201.   GetRecord(1, rcTemp);
  202.   DisplayRecord(rcTemp);
  203.   EraseRecord(1);
  204.   GetRecord(1, rcTemp);
  205.   DisplayRecord(rcTemp);
  206.   EnterRecData(rcTemp);
  207.   AddRecord(1, rcTemp);
  208.   DisplayRecord(rcTemp);
  209.   close(fiData);
  210.   if YesNo('Erase the Record data-File ?') then
  211.     erase(fiData)
  212. end.
  213.  
  214.  
  215.